TList and user defined type

You can use TList class for user defined data types such as Records. Below example
is used to store dictionary words in Electronic Book progam, most of TList methods
such as Add, Delete are modified to work with TDicWord record.

type
PDicWord = ^ TDicWord;
TDicWord = record
Word: string[30];
Meaning: string[100];
end; { TWord }

TWordsList = Class (TList)
protected
function Get(AIndex: integer): PDicWord;
procedure Put(AIndex: integer; Word:
PDicWord);
public
function Add(Word: TDicWord): integer;
procedure Delete(AIndex: integer);
procedure Clear; override;
procedure Free;
function IndexOf(Word: string): integer;
function LoadFromFile(FileName: string):
Boolean;
function SaveToFile(FileName: string):
Boolean;
procedure Sort;
property Items[ AIndex: integer ]:
PDicWord read Get write Put; default;

end; { TWordsList }

implementation

function TWordsList.Get(AIndex: integer): PDicWord;
begin
Result:= inherited Get(AIndex);
end;

procedure TWordsList.Put(AIndex: integer; Word: PDicWord);
begin
inherited Put(AIndex, Word);
end;

(************* Add word *****************)

function TWordsList.Add(Word: TDicWord): integer;
var
PWord: PDicWord;
begin
New(PWord);
PWord^:= Word;
Result:= inherited Add(PWord);
end;

(************* Delete word ****************)

procedure TWordsList.Delete(AIndex: integer);
var
Temp: pointer;
begin
if not (AIndex in [0 .. Count-1]) then exit;
Temp:= Items[AIndex];
Dispose(Temp);
inherited Delete(AIndex);
end;

(************* Clear list *************)

procedure TWordsList.Clear;
var
i: integer;
begin
for i:= 0 to Count-1 do
Delete(0);
inherited Clear;
pack;
end;

(*********** Free list ***********)

procedure TWordsList.Free;
begin
Clear;
inherited Clear;
end;

(***************** IndexOf *******************)

function TWordsList.IndexOf(Word: string): integer;
var
i: integer;
begin
for i:= 0 to Count-1 do
if UpperCase(Word) = UpperCase(Items[i].Word) then
begin
Result:= i; // found
exit; (*>>>>>>>*)
end;
Result:= -1; // not found
end;

(***************** Load From File *******************)

function TWordsList.LoadFromFile(FileName: string): boolean;
var
F: File of TDicWord;
AWord: TDicWord;
begin
Result:= false;
Clear;
try
if not FileExists(FileName) then exit; (*>>>>>*)
AssignFile(F, FileName);
FileMode:= 0;
Reset(F);
while not eof(F) do
begin
Read(F, AWord);
if (AWord.Word <> '') and (AWord.Meaning <> '') then
Add(AWord);
end; // while
CloseFile(F);
Result:= True; // Successed

except
on e: exception do
exit;
end; // try
end;

(***************** Save to File *******************)

function TWordsList.SaveToFile(FileName: string): boolean;
var
i: integer;
F: File of TDicWord;
AWord: TDicWord;
begin
Result:= false;
if Count = 0 then
begin
if FileExists(FileName) then
DeleteFile(FileName);
Result:= True;
exit; (*>>>>>>>>>*)
end; // if Count

Sort;

try
AssignFile(F, FileName);
Rewrite(F);
for i:= 0 to Count-1 do
begin
AWord:= Items[i]^;
Write(F, AWord);
end; // for i:= 0
CloseFile(F);
Result:= True; // Successed

except
on e: exception do
exit;
end; // try
end;

(********************** Words Compare **********************)

function WordsCompare(Item1, Item2: pointer): integer;
begin
if UpperCase(PDicWord(Item1)^.Word) <
UpperCase(PDicWord(Item2)^.Word) then
Result:= -1
else
if UpperCase(PDicWord(Item1)^.Word) >
UpperCase(PDicWord(Item2)^.Word) then
Result:= 1
else
Result:= 0;
end;

(********************** Sort **********************)

procedure TWordsList.Sort;
begin
inherited Sort(WordsCompare);
end;

See also

TStringList